PC Plus SuperCD (UK) 1994 June/PC Plus Super CD coverdisc Issue 93 June 1994.iso/suprdisk/button/frmsave.frm

Visual Basic Form | 1994-04-02 | 7.9 KB | 256 lines

VERSION 2.00
Begin Form frmSave
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Save to Disk"
   ClientHeight    =   2835
   ClientLeft      =   2805
   ClientTop       =   2190
   ClientWidth     =   6750
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   ForeColor       =   &H00000000&
   Height          =   3240
   Left            =   2745
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2835
   ScaleWidth      =   6750
   Top             =   1845
   Width           =   6870
   Begin CommandButton cmdDontSave
      Caption         =   "&DON'T SAVE"
      Height          =   375
      Left            =   4725
      TabIndex        =   4
      Top             =   1980
      Width           =   1740
   End
   Begin CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   5100
      TabIndex        =   5
      Top             =   1395
      Width           =   1365
   End
   Begin CommandButton cmdSave
      Caption         =   "&SAVE"
      Height          =   375
      Left            =   3150
      TabIndex        =   3
      Top             =   1980
      Width           =   1365
   End
   Begin TextBox tbxGroup
      Height          =   285
      Left            =   3150
      MaxLength       =   6
      TabIndex        =   2
      Top             =   1440
      Width           =   1665
   End
   Begin DirListBox Dir1
      Height          =   1605
      Left            =   300
      TabIndex        =   1
      Top             =   315
      Width           =   2415
   End
   Begin DriveListBox Drive1
      Height          =   315
      Left            =   300
      TabIndex        =   0
      Top             =   2025
      Width           =   2415
   End
   Begin Label Label8
      BackStyle       =   0  'Transparent
      Caption         =   "Directory :-"
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   3150
      TabIndex        =   6
      Top             =   315
      Width           =   1290
   End
   Begin Label lblDirectory
      BackStyle       =   0  'Transparent
      Caption         =   "lblDirectory"
      ForeColor       =   &H000000C0&
      Height          =   240
      Left            =   3150
      TabIndex        =   7
      Top             =   630
      Width           =   3465
   End
   Begin Label Label7
      BackStyle       =   0  'Transparent
      Caption         =   "Group Name (Max. 6 characters)"
      ForeColor       =   &H00000000&
      Height          =   285
      Left            =   3150
      TabIndex        =   8
      Top             =   1035
      Width           =   2865
   End
Option Explicit
Dim FileEnd(0 To 4) As String
Sub cmdCancel_Click ()
    frmSave.Tag = CANCEL_SAVE
    frmSave.Hide
End Sub
Sub cmdDontSave_Click ()
    frmSave.Tag = NOT_SAVED
    frmSave.Hide
End Sub
Sub cmdSave_Click ()
    Dim n As Integer
    Dim Msg As String
    Dim Directory As String
    Dim Answer As Integer
    On Error GoTo Wrong
    If tbxGroup = "" Then
        Error 32760
    End If
    GroupName = tbxGroup
    Directory = lblDirectory
    If Right$(Directory, 1) <> "\" Then Directory = Directory & "\"
    Select Case frmSave.Tag
        'All 3 buttons will saved as individual BMP files
        'so we need to update the disabled button
        Case S_TYPE_INDIVIDUAL
            Update_Button
            For n = 0 To 2
                FileEnd(n) = Directory & GroupName & FileEnd(n)
                Answer = SaveOK(FileEnd(n))
                Select Case Answer
                    Case 6           'OK to save
                        SavePicture B(n).Image, FileEnd(n)
                        ButtonChanged = False
                    Case 7           'Cancel
                        ButtonChanged = False
                    Case Else        'Don't save
                    ButtonChanged = True
                End Select
            Next n
        Case Else
            FileEnd(3) = Directory & GroupName & FileEnd(3)
            FileEnd(4) = Directory & GroupName & FileEnd(4)
            Answer = SaveOK(FileEnd(3))
            Select Case Answer
                Case 6              'OK to save
                    'Save the picture
                    SavePicture frmBitMap!picBitMap.Image, FileEnd(3)
                    BitMap.Changed = False
                    'Save the Data file
                    Save_BitMap_Info
                    ButtonChanged = False
                Case 7              'Cancel
                    ButtonChanged = False
                    BitMap.Changed = False
                Case Else
                    Rem             'Don't save
            End Select
    End Select
    Select Case Answer
        Case 2
            Answer = CANCEL_SAVE
        Case 6
            CurrentDirectory = Dir1.Path
            Answer = SAVED
        Case Else
            Answer = NOT_SAVED
    End Select
    frmSave.Tag = Answer   'The calling routine reads the tag to see what happened
    frmSave.Hide
Exit Sub
Wrong:
    If Err = 32760 Then
        Msg = "You haven't entered a Group name"
    Else
        Msg = Error$
    End If
    MsgBox Msg, 0, "Save Button"
    Exit Sub
    Resume Next
End Sub
Sub Dir1_Change ()
    lblDirectory = Dir1.Path
End Sub
Sub Dir1_Click ()
    lblDirectory = Dir1.Path
End Sub
Sub Drive1_Change ()
    On Error Resume Next
    Dir1.Path = Drive1.Drive
    If Err Then
        MsgBox Error$, 0, "Drive"
        Drive1.Drive = Dir1.Path
    End If
End Sub
Sub Form_Activate ()
'   The user supplies a 6 letter group name & the following endings are added
    'File endings for buttons saved individually
    FileEnd(0) = "_U.BMP"     'Up
    FileEnd(1) = "_D.BMP"     'Down
    FileEnd(2) = "_O.BMP"     'Off - Disabled
    'File endings for buttons saved in a master bitmap
    FileEnd(3) = "_B.BMP"     'The BMP file
    FileEnd(4) = "_B.DAT"     'The Data file
    lblDirectory = Dir1.Path
    tbxGroup = GroupName
    tbxGroup.SetFocus
    'If a file has previously been loaded then CurrentDirectory will
    'contain the directory it came from
    If Len(CurrentDirectory) > 0 Then Dir1.Path = CurrentDirectory
    HelpItem = 23
End Sub
Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
    If KeyCode = &H70 Then Cheap_Help Format$(HelpItem)
End Sub
Sub Form_Load ()
    Position_Form frmSave
    KeyPreview = True
End Sub
'   This routine saves all the information needed
'   to reload the master bitmap
Sub Save_BitMap_Info ()
    Dim handle As Integer
    On Error GoTo FileErr
    handle = FreeFile
    BitMap.ID = BUTTON_ID
    Open FileEnd(4) For Random As #handle Len = Len(BitMap)
        Put #handle, , BitMap
    Close #handle
GetOut:
Exit Sub
FileErr:
    MsgBox "Unable to save bitmap info " & Error$
    Resume GetOut
End Sub
Function SaveOK (F$) As Integer
    Dim l As Long
    On Error Resume Next
    l = FileLen(F$)   'If the file doesn't exist then FileLen will
                      'return err 53 (File not found). This means
                      'we can safely save the file
                      'If a file of the same name exists then err=0
                      'so we can check if it's OK to replace it
                      'Any other err number means something has gone wrong
    Select Case Err
        Case 0
            SaveOK = MsgBox("Overwrite existing file?", 35, F$)
        Case 53
            SaveOK = 6
        Case Else
            MsgBox Error$
    End Select
End Function
Sub tbxGroup_GotFocus ()
    tbxGroup.SelStart = 0
    tbxGroup.SelLength = Len(tbxGroup)
End Sub